Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/C/Games/NetHack 3.1.3/source/sys/unix/cpp3.shr

Text File | 1993-08-01 | 50.6 KB | 1,902 lines | [TEXT/R*ch]

# This is a shell archive.  Save it in a file, remove anything before
# this line, and then unpack it by entering "sh file".  Note, it may
# create directories; files and directories will be owned by you and
# have default permissions.
#
# This archive contains:
#
#    cpp5.c
#    cpp6.c
#
echo x - cpp5.c
sed 's/^X//' >cpp5.c << 'END-of-cpp5.c'
X/*
X *                C P P 5 . C
X *        E x p r e s s i o n   E v a l u a t i o n
X *
X * Edit History
X * 31-Aug-84    MM    USENET net.sources release
X * 04-Oct-84    MM    __LINE__ and __FILE__ must call ungetstring()
X *            so they work correctly with token concatenation.
X *            Added string formal recognition.
X * 25-Oct-84    MM    "Short-circuit" evaluate #if's so that we
X *            don't print unnecessary error messages for
X *            #if !defined(FOO) && FOO != 0 && 10 / FOO ...
X * 31-Oct-84    ado/MM    Added token concatenation
X *  6-Nov-84    MM    Split from #define stuff, added sizeof stuff
X * 19-Nov-84    ado    #if error returns TRUE for (sigh) compatibility
X */
X
X#include    <stdio.h>
X#include    <ctype.h>
X#include    "cppdef.h"
X#include    "cpp.h"
X
X/*
X * Evaluate an #if expression.
X */
X
Xstatic char    *opname[] = {        /* For debug and error messages    */
X"end of expression", "val", "id",
X  "+",   "-",  "*",  "/",  "%",
X  "<<", ">>",  "&",  "|",  "^",
X  "==", "!=",  "<", "<=", ">=",  ">",
X  "&&", "||",  "?",  ":",  ",",
X  "unary +", "unary -", "~", "!",  "(",  ")", "(none)",
X};
X
X/*
X * opdope[] has the operator precedence:
X *     Bits
X *      7    Unused (so the value is always positive)
X *    6-2    Precedence (000x .. 017x)
X *    1-0    Binary op. flags:
X *        01    The binop flag should be set/cleared when this op is seen.
X *        10    The new value of the binop flag.
X * Note:  Expected, New binop
X * constant    0    1    Binop, end, or ) should follow constants
X * End of line    1    0    End may not be preceeded by an operator
X * binary    1    0    Binary op follows a value, value follows.
X * unary    0    0    Unary op doesn't follow a value, value follows
X *   (        0    0    Doesn't follow value, value or unop follows
X *   )        1    1    Follows value.  Op follows.
X */
X
Xstatic char    opdope[OP_MAX] = {
X  0001,                    /* End of expression        */
X  0002,                    /* Digit            */
X  0000,                    /* Letter (identifier)        */
X  0141, 0141, 0151, 0151, 0151,        /* ADD, SUB, MUL, DIV, MOD    */
X  0131, 0131, 0101, 0071, 0071,        /* ASL, ASR, AND,  OR, XOR    */
X  0111, 0111, 0121, 0121, 0121,    0121,    /*  EQ,  NE,  LT,  LE,  GE,  GT    */
X  0061, 0051, 0041, 0041, 0031,        /* ANA, ORO, QUE, COL, CMA    */
X/*
X * Unary op's follow
X */
X  0160, 0160, 0160, 0160,        /* NEG, PLU, COM, NOT        */
X  0170, 0013, 0023,            /* LPA, RPA, END        */
X};
X/*
X * OP_QUE and OP_RPA have alternate precedences:
X */
X#define    OP_RPA_PREC    0013
X#define OP_QUE_PREC    0034
X
X/*
X * S_ANDOR and S_QUEST signal "short-circuit" boolean evaluation, so that
X *    #if FOO != 0 && 10 / FOO ...
X * doesn't generate an error message.  They are stored in optab.skip.
X */
X#define S_ANDOR        2
X#define S_QUEST        1
X
Xtypedef struct optab {
X    char    op;            /* Operator            */
X    char    prec;            /* Its precedence        */
X    char    skip;            /* Short-circuit: TRUE to skip    */
X} OPTAB;
Xstatic int    evalue;            /* Current value from evallex()    */
X
X#ifdef    nomacargs
XFILE_LOCAL int
Xisbinary(op)
Xregister int    op;
X{
X    return (op >= FIRST_BINOP && op <= LAST_BINOP);
X}
X
XFILE_LOCAL int
Xisunary(op)
Xregister int    op;
X{
X    return (op >= FIRST_UNOP && op <= LAST_UNOP);
X}
X#else
X#define    isbinary(op)    (op >= FIRST_BINOP && op <= LAST_BINOP)
X#define    isunary(op)    (op >= FIRST_UNOP  && op <= LAST_UNOP)
X#endif
X
X/*
X * The following definitions are used to specify basic variable sizes.
X */
X
X#ifndef    S_CHAR
X#define    S_CHAR        (sizeof (char))
X#endif
X#ifndef    S_SINT
X#define    S_SINT        (sizeof (short int))
X#endif
X#ifndef    S_INT
X#define    S_INT        (sizeof (int))
X#endif
X#ifndef    S_LINT
X#define    S_LINT        (sizeof (long int))
X#endif
X#ifndef    S_FLOAT
X#define    S_FLOAT        (sizeof (float))
X#endif
X#ifndef    S_DOUBLE
X#define    S_DOUBLE    (sizeof (double))
X#endif
X#ifndef    S_PCHAR
X#define    S_PCHAR        (sizeof (char *))
X#endif
X#ifndef    S_PSINT
X#define    S_PSINT        (sizeof (short int *))
X#endif
X#ifndef    S_PINT
X#define    S_PINT        (sizeof (int *))
X#endif
X#ifndef    S_PLINT
X#define    S_PLINT        (sizeof (long int *))
X#endif
X#ifndef    S_PFLOAT
X#define    S_PFLOAT    (sizeof (float *))
X#endif
X#ifndef    S_PDOUBLE
X#define    S_PDOUBLE    (sizeof (double *))
X#endif
X#ifndef    S_PFPTR
X#define S_PFPTR        (sizeof (int (*)()))
X#endif
X
Xtypedef struct types {
X    short    type;            /* This is the bit if        */
X    char    *name;            /* this is the token word    */
X} TYPES;
X
Xstatic TYPES basic_types[] = {
X    { T_CHAR,    "char",        },
X    { T_INT,    "int",        },
X    { T_FLOAT,    "float",    },
X    { T_DOUBLE,    "double",    },
X    { T_SHORT,    "short",    },
X    { T_LONG,    "long",        },
X    { T_SIGNED,    "signed",    },
X    { T_UNSIGNED,    "unsigned",    },
X    { 0,        NULL,        },    /* Signal end        */
X};
X
X/*
X * Test_table[] is used to test for illegal combinations.
X */
Xstatic short test_table[] = {
X    T_FLOAT | T_DOUBLE | T_LONG | T_SHORT,
X    T_FLOAT | T_DOUBLE | T_CHAR | T_INT,
X    T_FLOAT | T_DOUBLE | T_SIGNED | T_UNSIGNED,
X    T_LONG  | T_SHORT  | T_CHAR,
X    0                        /* end marker    */
X};
X
X/*
X * The order of this table is important -- it is also referenced by
X * the command line processor to allow run-time overriding of the
X * built-in size values.  The order must not be changed:
X *    char, short, int, long, float, double (func pointer)
X */
XSIZES size_table[] = {
X    { T_CHAR,    S_CHAR,        S_PCHAR        },    /* char        */
X    { T_SHORT,    S_SINT,        S_PSINT        },    /* short int    */
X    { T_INT,    S_INT,        S_PINT        },    /* int        */
X    { T_LONG,    S_LINT,        S_PLINT        },    /* long        */
X    { T_FLOAT,    S_FLOAT,    S_PFLOAT    },    /* float    */
X    { T_DOUBLE,    S_DOUBLE,    S_PDOUBLE    },    /* double    */
X    { T_FPTR,    0,        S_PFPTR        },    /* int (*())     */
X    { 0,    0,        0        },    /* End of table    */
X};
X
Xint
Xeval()
X/*
X * Evaluate an expression.  Straight-forward operator precedence.
X * This is called from control() on encountering an #if statement.
X * It calls the following routines:
X * evallex    Lexical analyser -- returns the type and value of
X *        the next input token.
X * evaleval    Evaluate the current operator, given the values on
X *        the value stack.  Returns a pointer to the (new)
X *        value stack.
X * For compatiblity with older cpp's, this return returns 1 (TRUE)
X * if a syntax error is detected.
X */
X{
X    register int    op;        /* Current operator        */
X    register int    *valp;        /* -> value vector        */
X    register OPTAB    *opp;        /* Operator stack        */
X    int        prec;        /* Op precedence        */
X    int        binop;        /* Set if binary op. needed    */
X    int        op1;        /* Operand from stack        */
X    int        skip;        /* For short-circuit testing    */
X    int        value[NEXP];    /* Value stack            */
X    OPTAB        opstack[NEXP];    /* Operand stack        */
X    extern int    *evaleval();    /* Does actual evaluation    */
X
X    valp = value;
X    opp = opstack;
X    opp->op = OP_END;        /* Mark bottom of stack        */
X    opp->prec = opdope[OP_END];    /* And its precedence        */
X    opp->skip = 0;            /* Not skipping now        */
X    binop = 0;
Xagain:    ;
X#ifdef    DEBUG_EVAL
X    printf("In #if at again: skip = %d, binop = %d, line is: %s",
X        opp->skip, binop, infile->bptr);
X#endif
X    if ((op = evallex(opp->skip)) == OP_SUB && binop == 0)
X        op = OP_NEG;            /* Unary minus        */
X    else if (op == OP_ADD && binop == 0)
X        op = OP_PLU;            /* Unary plus        */
X    else if (op == OP_FAIL)
X        return (1);                /* Error in evallex    */
X#ifdef    DEBUG_EVAL
X    printf("op = %s, opdope = %03o, binop = %d, skip = %d\n",
X        opname[op], opdope[op], binop, opp->skip);
X#endif
X    if (op == DIG) {            /* Value?        */
X        if (binop != 0) {
X        cerror("misplaced constant in #if", NULLST);
X        return (1);
X        }
X        else if (valp >= &value[NEXP-1]) {
X        cerror("#if value stack overflow", NULLST);
X        return (1);
X        }
X        else {
X#ifdef    DEBUG_EVAL
X        printf("pushing %d onto value stack[%d]\n",
X            evalue, valp - value);
X#endif
X        *valp++ = evalue;
X        binop = 1;
X        }
X        goto again;
X    }
X    else if (op > OP_END) {
X        cerror("Illegal #if line", NULLST);
X        return (1);
X    }
X    prec = opdope[op];
X    if (binop != (prec & 1)) {
X        cerror("Operator %s in incorrect context", opname[op]);
X        return (1);
X    }
X    binop = (prec & 2) >> 1;
X    for (;;) {
X#ifdef    DEBUG_EVAL
X        printf("op %s, prec %d., stacked op %s, prec %d, skip %d\n",
X        opname[op], prec, opname[opp->op], opp->prec, opp->skip);
X#endif
X        if (prec > opp->prec) {
X        if (op == OP_LPA)
X            prec = OP_RPA_PREC;
X        else if (op == OP_QUE)
X            prec = OP_QUE_PREC;
X        op1 = opp->skip;        /* Save skip for test    */
X        /*
X         * Push operator onto op. stack.
X         */
X        opp++;
X        if (opp >= &opstack[NEXP]) {
X            cerror("expression stack overflow at op \"%s\"",
X            opname[op]);
X            return (1);
X        }
X        opp->op = op;
X        opp->prec = prec;
X        skip = (valp[-1] != 0);        /* Short-circuit tester    */
X        /*
X         * Do the short-circuit stuff here.  Short-circuiting
X         * stops automagically when operators are evaluated.
X         */
X        if ((op == OP_ANA && !skip)
X         || (op == OP_ORO && skip))
X            opp->skip = S_ANDOR;    /* And/or skip starts    */
X        else if (op == OP_QUE)        /* Start of ?: operator    */
X            opp->skip = (op1 & S_ANDOR) | ((!skip) ? S_QUEST : 0);
X        else if (op == OP_COL) {    /* : inverts S_QUEST    */
X            opp->skip = (op1 & S_ANDOR)
X                  | (((op1 & S_QUEST) != 0) ? 0 : S_QUEST);
X        }
X        else {                /* Other ops leave    */
X            opp->skip = op1;        /*  skipping unchanged.    */
X        }
X#ifdef    DEBUG_EVAL
X        printf("stacking %s, valp[-1] == %d at %s",
X            opname[op], valp[-1], infile->bptr);
X        dumpstack(opstack, opp, value, valp);
X#endif
X        goto again;
X        }
X        /*
X         * Pop operator from op. stack and evaluate it.
X         * End of stack and '(' are specials.
X         */
X        skip = opp->skip;            /* Remember skip value    */
X        switch ((op1 = opp->op)) {        /* Look at stacked op    */
X        case OP_END:            /* Stack end marker    */
X        if (op == OP_EOE)
X            return (valp[-1]);        /* Finished ok.        */
X        goto again;            /* Read another op.    */
X
X        case OP_LPA:            /* ( on stack        */
X        if (op != OP_RPA) {        /* Matches ) on input    */
X            cerror("unbalanced paren's, op is \"%s\"", opname[op]);
X            return (1);
X        }
X        opp--;                /* Unstack it        */
X        /* goto again;            -- Fall through        */
X
X        case OP_QUE:
X        goto again;            /* Evaluate true expr.    */
X
X        case OP_COL:            /* : on stack.        */
X        opp--;                /* Unstack :        */
X        if (opp->op != OP_QUE) {    /* Matches ? on stack?    */
X            cerror("Misplaced '?' or ':', previous operator is %s",
X            opname[opp->op]);
X            return (1);
X        }
X        /*
X         * Evaluate op1.
X         */
X        default:                /* Others:        */
X        opp--;                /* Unstack the operator    */
X#ifdef    DEBUG_EVAL
X        printf("Stack before evaluation of %s\n", opname[op1]);
X        dumpstack(opstack, opp, value, valp);
X#endif
X        valp = evaleval(valp, op1, skip);
X#ifdef    DEBUG_EVAL
X        printf("Stack after evaluation\n");
X        dumpstack(opstack, opp, value, valp);
X#endif
X        }                    /* op1 switch end    */
X    }                    /* Stack unwind loop    */
X}
X
XFILE_LOCAL int
Xevallex(skip)
Xint        skip;        /* TRUE if short-circuit evaluation    */
X/*
X * Return next eval operator or value.  Called from eval().  It
X * calls a special-purpose routines for 'char' strings and
X * numeric values:
X * evalchar    called to evaluate 'x'
X * evalnum    called to evaluate numbers.
X */
X{
X    register int    c, c1, t;
X
Xagain:  do {                    /* Collect the token    */
X        c = skipws();
X        if ((c = macroid(c)) == EOF_CHAR || c == '\n') {
X        unget();
X        return (OP_EOE);        /* End of expression    */
X        }
X    } while ((t = type[c]) == LET && catenate());
X    if (t == INV) {                /* Total nonsense    */
X        if (!skip) {
X        if (isascii(c) && isprint(c))
X            cierror("illegal character '%c' in #if", c);
X        else
X            cierror("illegal character (%d decimal) in #if", c);
X        }
X        return (OP_FAIL);
X    }
X    else if (t == QUO) {            /* ' or "        */
X        if (c == '\'') {            /* Character constant    */
X        evalue = evalchar(skip);    /* Somewhat messy    */
X#ifdef    DEBUG_EVAL
X        printf("evalchar returns %d.\n", evalue);
X#endif
X        return (DIG);            /* Return a value    */
X        }
X        cerror("Can't use a string in an #if", NULLST);
X        return (OP_FAIL);
X    }
X    else if (t == LET) {            /* ID must be a macro    */
X        if (streq(token, "defined")) {    /* Or defined name    */
X        c1 = c = skipws();
X        if (c == '(')            /* Allow defined(name)    */
X            c = skipws();
X        if (type[c] == LET) {
X            evalue = (lookid(c) != NULL);
X            if (c1 != '('        /* Need to balance    */
X             || skipws() == ')')    /* Did we balance?    */
X            return (DIG);        /* Parsed ok        */
X        }
X        cerror("Bad #if ... defined() syntax", NULLST);
X        return (OP_FAIL);
X        }
X        else if (streq(token, "sizeof"))    /* New sizeof hackery    */
X        return (dosizeof());        /* Gets own routine    */
X        /*
X         * The Draft ANSI C Standard says that an undefined symbol
X         * in an #if has the value zero.  We are a bit pickier,
X         * warning except where the programmer was careful to write
X         *         #if defined(foo) ? foo : 0
X         */
X#ifdef VERBOSE
X         if (!skip)
X          cwarn("undefined symbol \"%s\" in #if, 0 used", token);
X#endif
X        evalue = 0;
X        return (DIG);
X    }
X    else if (t == DIG) {            /* Numbers are harder    */
X        evalue = evalnum(c);
X#ifdef    DEBUG_EVAL
X        printf("evalnum returns %d.\n", evalue);
X#endif
X    }
X    else if (strchr("!=<>&|\\", c) != NULL) {
X        /*
X         * Process a possible multi-byte lexeme.
X         */
X        c1 = cget();            /* Peek at next char    */
X        switch (c) {
X        case '!':
X        if (c1 == '=')
X            return (OP_NE);
X        break;
X
X        case '=':
X        if (c1 != '=') {        /* Can't say a=b in #if    */
X            unget();
X            cerror("= not allowed in #if", NULLST);
X            return (OP_FAIL);
X        }
X        return (OP_EQ);
X
X        case '>':
X        case '<':
X        if (c1 == c)
X            return ((c == '<') ? OP_ASL : OP_ASR);
X        else if (c1 == '=')
X            return ((c == '<') ? OP_LE  : OP_GE);
X        break;
X
X        case '|':
X        case '&':
X        if (c1 == c)
X            return ((c == '|') ? OP_ORO : OP_ANA);
X        break;
X
X        case '\\':
X        if (c1 == '\n')            /* Multi-line if    */
X            goto again;
X        cerror("Unexpected \\ in #if", NULLST);
X        return (OP_FAIL);
X        }
X        unget();
X    }
X    return (t);
X}
X
XFILE_LOCAL int
Xdosizeof()
X/*
X * Process the sizeof (basic type) operation in an #if string.
X * Sets evalue to the size and returns
X *    DIG        success
X *    OP_FAIL        bad parse or something.
X */
X{
X    register int    c;
X    register TYPES    *tp;
X    register SIZES    *sizp;
X    register short    *testp;
X    short        typecode;
X
X    if ((c = skipws()) != '(')
X        goto nogood;
X    /*
X     * Scan off the tokens.
X     */
X    typecode = 0;
X    while ((c = skipws())) {
X        if ((c = macroid(c)) == EOF_CHAR || c == '\n')
X        goto nogood;            /* End of line is a bug    */
X        else if (c == '(') {        /* thing (*)() func ptr    */
X        if (skipws() == '*'
X         && skipws() == ')') {        /* We found (*)        */
X            if (skipws() != '(')    /* Let () be optional    */
X            unget();
X            else if (skipws() != ')')
X            goto nogood;
X            typecode |= T_FPTR;        /* Function pointer    */
X        }
X        else {                /* Junk is a bug    */
X            goto nogood;
X        }
X        }
X        else if (type[c] != LET)        /* Exit if not a type    */
X        break;
X        else if (!catenate()) {        /* Maybe combine tokens    */
X        /*
X         * Look for this unexpandable token in basic_types.
X         * The code accepts "int long" as well as "long int"
X         * which is a minor bug as bugs go (and one shared with
X         * a lot of C compilers).
X         */
X        for (tp = basic_types; tp->name != NULLST; tp++) {
X            if (streq(token, tp->name))
X            break;
X        }
X        if (tp->name == NULLST) {
X            cerror("#if sizeof, unknown type \"%s\"", token);
X            return (OP_FAIL);
X        }
X        typecode |= tp->type;        /* Or in the type bit    */
X        }
X    }
X    /*
X     * We are at the end of the type scan.  Chew off '*' if necessary.
X     */
X    if (c == '*') {
X        typecode |= T_PTR;
X        c = skipws();
X    }
X    if (c == ')') {                /* Last syntax check    */
X        for (testp = test_table; *testp != 0; testp++) {
X        if (!bittest(typecode & *testp)) {
X            cerror("#if ... sizeof: illegal type combination", NULLST);
X            return (OP_FAIL);
X        }
X        }
X        /*
X         * We assume that all function pointers are the same size:
X         *        sizeof (int (*)()) == sizeof (float (*)())
X         * We assume that signed and unsigned don't change the size:
X         *        sizeof (signed int) == (sizeof unsigned int)
X         */
X        if ((typecode & T_FPTR) != 0)    /* Function pointer    */
X        typecode = T_FPTR | T_PTR;
X        else {                /* Var or var * datum    */
X        typecode &= ~(T_SIGNED | T_UNSIGNED);
X        if ((typecode & (T_SHORT | T_LONG)) != 0)
X            typecode &= ~T_INT;
X        }
X        if ((typecode & ~T_PTR) == 0) {
X        cerror("#if sizeof() error, no type specified", NULLST);
X        return (OP_FAIL);
X        }
X        /*
X         * Exactly one bit (and possibly T_PTR) may be set.
X         */
X        for (sizp = size_table; sizp->bits != 0; sizp++) {
X        if ((typecode & ~T_PTR) == sizp->bits) {
X            evalue = ((typecode & T_PTR) != 0)
X            ? sizp->psize : sizp->size;
X            return (DIG);
X        }
X        }                    /* We shouldn't fail    */
X        cierror("#if ... sizeof: bug, unknown type code 0x%x", typecode);
X        return (OP_FAIL);
X    }
X
Xnogood:    unget();
X    cerror("#if ... sizeof() syntax error", NULLST);
X    return (OP_FAIL);
X}
X
XFILE_LOCAL int
Xbittest(value)
X/*
X * TRUE if value is zero or exactly one bit is set in value.
X */
X{
X#if (4096 & ~(-4096)) == 0
X    return ((value & ~(-value)) == 0);
X#else
X    /*
X     * Do it the hard way (for non 2's complement machines)
X     */
X    return (value == 0 || value ^ (value - 1) == (value * 2 - 1));
X#endif
X}
X
XFILE_LOCAL int
Xevalnum(c)
Xregister int    c;
X/*
X * Expand number for #if lexical analysis.  Note: evalnum recognizes
X * the unsigned suffix, but only returns a signed int value.
X */
X{
X    register int    value;
X    register int    base;
X    register int    c1;
X
X    if (c != '0')
X        base = 10;
X    else if ((c = cget()) == 'x' || c == 'X') {
X        base = 16;
X        c = cget();
X    }
X    else base = 8;
X    value = 0;
X    for (;;) {
X        c1 = c;
X        if (isascii(c) && isupper(c1))
X        c1 = tolower(c1);
X        if (c1 >= 'a')
X        c1 -= ('a' - 10);
X        else c1 -= '0';
X        if (c1 < 0 || c1 >= base)
X        break;
X        value *= base;
X        value += c1;
X        c = cget();
X    }
X    if (c == 'u' || c == 'U')    /* Unsigned nonsense        */
X        c = cget();
X    unget();
X    return (value);
X}
X
XFILE_LOCAL int
Xevalchar(skip)
Xint        skip;        /* TRUE if short-circuit evaluation    */
X/*
X * Get a character constant
X */
X{
X    register int    c;
X    register int    value;
X    register int    count;
X
X    instring = TRUE;
X    if ((c = cget()) == '\\') {
X        switch ((c = cget())) {
X        case 'a':                /* New in Standard    */
X#if ('a' == '\a' || '\a' == ALERT)
X        value = ALERT;            /* Use predefined value    */
X#else
X        value = '\a';            /* Use compiler's value    */
X#endif
X        break;
X
X        case 'b':
X        value = '\b';
X        break;
X
X        case 'f':
X        value = '\f';
X        break;
X
X        case 'n':
X        value = '\n';
X        break;
X
X        case 'r':
X        value = '\r';
X        break;
X
X        case 't':
X        value = '\t';
X        break;
X
X        case 'v':                /* New in Standard    */
X#if ('v' == '\v' || '\v' == VT)
X        value = VT;            /* Use predefined value    */
X#else
X        value = '\v';            /* Use compiler's value    */
X#endif
X        break;
X
X        case 'x':                /* '\xFF'        */
X        count = 3;
X        value = 0;
X        while ((((c = get()) >= '0' && c <= '9')
X             || (c >= 'a' && c <= 'f')
X             || (c >= 'A' && c <= 'F'))
X            && (--count >= 0)) {
X            value *= 16;
X            value += (c <= '9') ? (c - '0') : ((c & 0xF) + 9);
X        }
X        unget();
X        break;
X
X        default:
X        if (c >= '0' && c <= '7') {
X            count = 3;
X            value = 0;
X            while (c >= '0' && c <= '7' && --count >= 0) {
X            value *= 8;
X            value += (c - '0');
X            c = get();
X            }
X            unget();
X        }
X        else value = c;
X        break;
X        }
X    }
X    else if (c == '\'')
X        value = 0;
X    else value = c;
X    /*
X     * We warn on multi-byte constants and try to hack
X     * (big|little)endian machines.
X     */
X#if BIG_ENDIAN
X    count = 0;
X#endif
X    while ((c = get()) != '\'' && c != EOF_CHAR && c != '\n') {
X        if (!skip)
X        ciwarn("multi-byte constant '%c' isn't portable", c);
X#if BIG_ENDIAN
X        count += BITS_CHAR;
X        value += (c << count);
X#else
X        value <<= BITS_CHAR;
X        value += c;
X#endif
X    }
X    instring = FALSE;
X    return (value);
X}
X
XFILE_LOCAL int *
Xevaleval(valp, op, skip)
Xregister int    *valp;
Xint        op;
Xint        skip;        /* TRUE if short-circuit evaluation    */
X/*
X * Apply the argument operator to the data on the value stack.
X * One or two values are popped from the value stack and the result
X * is pushed onto the value stack.
X *
X * OP_COL is a special case.
X *
X * evaleval() returns the new pointer to the top of the value stack.
X */
X{
X    register int    v1, v2;
X
X    if (isbinary(op))
X        v2 = *--valp;
X    v1 = *--valp;
X#ifdef    DEBUG_EVAL
X    printf("%s op %s", (isbinary(op)) ? "binary" : "unary",
X        opname[op]);
X    if (isbinary(op))
X        printf(", v2 = %d.", v2);
X    printf(", v1 = %d.\n", v1);
X#endif
X    switch (op) {
X    case OP_EOE:
X         break;
X
X    case OP_ADD:
X        v1 += v2;
X        break;
X
X    case OP_SUB:
X        v1 -= v2;
X        break;
X
X    case OP_MUL:
X        v1 *= v2;
X        break;
X
X    case OP_DIV:
X    case OP_MOD:
X        if (v2 == 0) {
X        if (!skip) {
X            cwarn("%s by zero in #if, zero result assumed",
X            (op == OP_DIV) ? "divide" : "mod");
X        }
X        v1 = 0;
X        }
X        else if (op == OP_DIV)
X        v1 /= v2;
X        else
X        v1 %= v2;
X        break;
X
X    case OP_ASL:
X        v1 <<= v2;
X        break;
X
X    case OP_ASR:
X        v1 >>= v2;
X        break;
X
X    case OP_AND:
X        v1 &= v2;
X        break;
X
X    case OP_OR:
X        v1 |= v2;
X        break;
X
X    case OP_XOR:
X        v1 ^= v2;
X        break;
X
X    case OP_EQ:
X        v1 = (v1 == v2);
X        break;
X
X    case OP_NE:
X        v1 = (v1 != v2);
X        break;
X
X    case OP_LT:
X        v1 = (v1 < v2);
X        break;
X
X    case OP_LE:
X        v1 = (v1 <= v2);
X        break;
X
X    case OP_GE:
X        v1 = (v1 >= v2);
X        break;
X
X    case OP_GT:
X        v1 = (v1 > v2);
X        break;
X
X    case OP_ANA:
X        v1 = (v1 && v2);
X        break;
X
X    case OP_ORO:
X        v1 = (v1 || v2);
X        break;
X
X    case OP_COL:
X        /*
X         * v1 has the "true" value, v2 the "false" value.
X         * The top of the value stack has the test.
X         */
X        v1 = (*--valp) ? v1 : v2;
X        break;
X
X    case OP_NEG:
X        v1 = (-v1);
X        break;
X
X    case OP_PLU:
X        break;
X
X    case OP_COM:
X        v1 = ~v1;
X        break;
X
X    case OP_NOT:
X        v1 = !v1;
X        break;
X
X    default:
X        cierror("#if bug, operand = %d.", op);
X        v1 = 0;
X    }
X    *valp++ = v1;
X    return (valp);
X}
X
X#ifdef    DEBUG_EVAL
Xdumpstack(opstack, opp, value, valp)
XOPTAB        opstack[NEXP];    /* Operand stack        */
Xregister OPTAB    *opp;        /* Operator stack        */
Xint        value[NEXP];    /* Value stack            */
Xregister int    *valp;        /* -> value vector        */
X{
X    printf("index op prec skip name -- op stack at %s", infile->bptr);
X    while (opp > opstack) {
X        printf(" [%2d] %2d  %03o    %d %s\n", opp - opstack,
X        opp->op, opp->prec, opp->skip, opname[opp->op]);
X        opp--;
X    }
X    while (--valp >= value) {
X        printf("value[%d] = %d\n", (valp - value), *valp);
X    }
X}
X#endif
X
END-of-cpp5.c
echo x - cpp6.c
sed 's/^X//' >cpp6.c << 'END-of-cpp6.c'
X/*
X *                C P P 6 . C
X *        S u p p o r t   R o u t i n e s
X *
X * Edit History
X * 25-May-84 MM        Added 8-bit support to type table.
X * 30-May-84 ARF    sharp() should output filename in quotes
X * 02-Aug-84 MM        Newline and #line hacking.  sharp() now in cpp1.c
X * 31-Aug-84 MM        USENET net.sources release
X * 11-Sep-84 ado/MM    Keepcomments, also line number pathological
X * 12-Sep-84 ado/MM    bug if comment changes to space and we unget later.
X * 03-Oct-84 gkr/MM    Fixed scannumber bug for '.e' (as in struct.element).
X * 04-Oct-84 MM        Added ungetstring() for token concatenation
X * 08-Oct-84 MM        Yet another attack on number scanning
X * 31-Oct-84 ado    Parameterized $ in identifiers
X *  2-Nov-84 MM        Token concatenation is messier than I thought
X *  6-Dec-84 MM        \<nl> is everywhere invisible.
X */
X
X#include    <stdio.h>
X#include    <ctype.h>
X#include    "cppdef.h"
X#include    "cpp.h"
X
X/*
X * skipnl()    skips over input text to the end of the line.
X * skipws()    skips over "whitespace" (spaces or tabs), but
X *        not skip over the end of the line.  It skips over
X *        TOK_SEP, however (though that shouldn't happen).
X * scanid()    reads the next token (C identifier) into token[].
X *        The caller has already read the first character of
X *        the identifier.  Unlike macroid(), the token is
X *        never expanded.
X * macroid()    reads the next token (C identifier) into token[].
X *        If it is a #defined macro, it is expanded, and
X *        macroid() returns TRUE, otherwise, FALSE.
X * catenate()    Does the dirty work of token concatenation, TRUE if it did.
X * scanstring()    Reads a string from the input stream, calling
X *        a user-supplied function for each character.
X *        This function may be output() to write the
X *        string to the output file, or save() to save
X *        the string in the work buffer.
X * scannumber()    Reads a C numeric constant from the input stream,
X *        calling the user-supplied function for each
X *        character.  (output() or save() as noted above.)
X * save()    Save one character in the work[] buffer.
X * savestring()    Saves a string in malloc() memory.
X * getfile()    Initialize a new FILEINFO structure, called when
X *        #include opens a new file, or a macro is to be
X *        expanded.
X * getmem()    Get a specified number of bytes from malloc memory.
X * output()    Write one character to stdout (calling putchar) --
X *        implemented as a function so its address may be
X *        passed to scanstring() and scannumber().
X * lookid()    Scans the next token (identifier) from the input
X *        stream.  Looks for it in the #defined symbol table.
X *        Returns a pointer to the definition, if found, or NULL
X *        if not present.  The identifier is stored in token[].
X * defnedel()    Define enter/delete subroutine.  Updates the
X *        symbol table.
X * get()    Read the next byte from the current input stream,
X *        handling end of (macro/file) input and embedded
X *        comments appropriately.  Note that the global
X *        instring is -- essentially -- a parameter to get().
X * cget()    Like get(), but skip over TOK_SEP.
X * unget()    Push last gotten character back on the input stream.
X * cerror(), cwarn(), cfatal(), cierror(), ciwarn()
X *        These routines format an print messages to the user.
X *        cerror & cwarn take a format and a single string argument.
X *        cierror & ciwarn take a format and a single int (char) argument.
X *        cfatal takes a format and a single string argument.
X */
X
X/*
X * This table must be rewritten for a non-Ascii machine.
X *
X * Note that several "non-visible" characters have special meaning:
X * Hex 1D DEF_MAGIC -- a flag to prevent #define recursion.
X * Hex 1E TOK_SEP   -- a delimiter for token concatenation
X * Hex 1F COM_SEP   -- a zero-width whitespace for comment concatenation
X */
X#if TOK_SEP != 0x1E || COM_SEP != 0x1F || DEF_MAGIC != 0x1D
X    << error type table isn't correct >>
X#endif
X
X#if OK_DOLLAR
X#define    DOL    LET
X#else
X#define    DOL    000
X#endif
X
Xchar type[256] = {        /* Character type codes    Hex        */
X   END,   000,   000,   000,   000,   000,   000,   000, /* 00        */
X   000,   SPA,   000,   000,   000,   000,   000,   000, /* 08        */
X   000,   000,   000,   000,   000,   000,   000,   000, /* 10        */
X   000,   000,   000,   000,   000,   LET,   000,   SPA, /* 18        */
X   SPA,OP_NOT,   QUO,   000,   DOL,OP_MOD,OP_AND,   QUO, /* 20  !"#$%&'    */
XOP_LPA,OP_RPA,OP_MUL,OP_ADD,   000,OP_SUB,   DOT,OP_DIV, /* 28 ()*+,-./    */
X   DIG,   DIG,   DIG,   DIG,   DIG,   DIG,   DIG,   DIG, /* 30 01234567    */
X   DIG,   DIG,OP_COL,   000, OP_LT, OP_EQ, OP_GT,OP_QUE, /* 38 89:;<=>?    */
X   000,   LET,   LET,   LET,   LET,   LET,   LET,   LET, /* 40 @ABCDEFG    */
X   LET,   LET,   LET,   LET,   LET,   LET,   LET,   LET, /* 48 HIJKLMNO    */
X   LET,   LET,   LET,   LET,   LET,   LET,   LET,   LET, /* 50 PQRSTUVW    */
X   LET,   LET,   LET,   000,   BSH,   000,OP_XOR,   LET, /* 58 XYZ[\]^_    */
X   000,   LET,   LET,   LET,   LET,   LET,   LET,   LET, /* 60 `abcdefg    */
X   LET,   LET,   LET,   LET,   LET,   LET,   LET,   LET, /* 68 hijklmno    */
X   LET,   LET,   LET,   LET,   LET,   LET,   LET,   LET, /* 70 pqrstuvw    */
X   LET,   LET,   LET,   000, OP_OR,   000,OP_NOT,   000, /* 78 xyz{|}~    */
X   000,   000,   000,   000,   000,   000,   000,   000, /*   80 .. FF    */
X   000,   000,   000,   000,   000,   000,   000,   000, /*   80 .. FF    */
X   000,   000,   000,   000,   000,   000,   000,   000, /*   80 .. FF    */
X   000,   000,   000,   000,   000,   000,   000,   000, /*   80 .. FF    */
X   000,   000,   000,   000,   000,   000,   000,   000, /*   80 .. FF    */
X   000,   000,   000,   000,   000,   000,   000,   000, /*   80 .. FF    */
X   000,   000,   000,   000,   000,   000,   000,   000, /*   80 .. FF    */
X   000,   000,   000,   000,   000,   000,   000,   000, /*   80 .. FF    */
X};
X
Xskipnl()
X/*
X * Skip to the end of the current input line.
X */
X{
X    register int        c;
X
X    do {                /* Skip to newline    */
X        c = get();
X    } while (c != '\n' && c != EOF_CHAR);
X}
X
Xint
Xskipws()
X/*
X * Skip over whitespace
X */
X{
X    register int        c;
X
X    do {                /* Skip whitespace    */
X        c = get();
X#if COMMENT_INVISIBLE
X    } while (type[c] == SPA || c == COM_SEP);
X#else
X    } while (type[c] == SPA);
X#endif
X    return (c);
X}
X
Xscanid(c)
Xregister int    c;                /* First char of id    */
X/*
X * Get the next token (an id) into the token buffer.
X * Note: this code is duplicated in lookid().
X * Change one, change both.
X */
X{
X    register char    *bp;
X
X    if (c == DEF_MAGIC)            /* Eat the magic token    */
X        c = get();                /* undefiner.        */
X    bp = token;
X    do {
X        if (bp < &token[IDMAX])        /* token dim is IDMAX+1    */
X        *bp++ = c;
X        c = get();
X    } while (type[c] == LET || type[c] == DIG);
X    unget();
X    *bp = EOS;
X}
X
Xint
Xmacroid(c)
Xregister int        c;
X/*
X * If c is a letter, scan the id.  if it's #defined, expand it and scan
X * the next character and try again.
X *
X * Else, return the character.  If type[c] is a LET, the token is in token.
X */
X{
X    register DEFBUF    *dp;
X
X    if (infile != NULL && infile->fp != NULL)
X        recursion = 0;
X    while (type[c] == LET && (dp = lookid(c)) != NULL) {
X        expand(dp);
X        c = get();
X    }
X    return (c);
X}
X
Xint
Xcatenate()
X/*
X * A token was just read (via macroid).
X * If the next character is TOK_SEP, concatenate the next token
X * return TRUE -- which should recall macroid after refreshing
X * macroid's argument.  If it is not TOK_SEP, unget() the character
X * and return FALSE.
X */
X{
X    register int        c;
X    register char        *token1;
X
X#if OK_CONCAT
X    if (get() != TOK_SEP) {            /* Token concatenation    */
X        unget();
X        return (FALSE);
X    }
X    else {
X        token1 = savestring(token);        /* Save first token    */
X        c = macroid(get());            /* Scan next token    */
X        switch(type[c]) {            /* What was it?        */
X        case LET:                /* An identifier, ...    */
X        if (strlen(token1) + strlen(token) >= NWORK)
X            cfatal("work buffer overflow doing %s #", token1);
X        sprintf(work, "%s%s", token1, token);
X        break;
X
X        case DIG:                /* A digit string    */
X        strcpy(work, token1);
X        workp = work + strlen(work);
X        do {
X            save(c);
X        } while ((c = get()) != TOK_SEP);
X        /*
X         * The trailing TOK_SEP is no longer needed.
X         */
X        save(EOS);
X        break;
X
X        default:                /* An error, ...    */
X        if (isprint(c))
X            cierror("Strange character '%c' after #", c);
X        else
X            cierror("Strange character (%d.) after #", c);
X        strcpy(work, token1);
X        unget();
X        break;
X        }
X        /*
X         * work has the concatenated token and token1 has
X         * the first token (no longer needed).  Unget the
X         * new (concatenated) token after freeing token1.
X         * Finally, setup to read the new token.
X         */
X        free(token1);            /* Free up memory    */
X        ungetstring(work);            /* Unget the new thing,    */
X        return (TRUE);
X    }
X#else
X    return (FALSE);                /* Not supported    */
X#endif
X}
X
Xint
Xscanstring(delim, outfun)
Xregister int    delim;            /* ' or "            */
Xint        (*outfun)();        /* Output function        */
X/*
X * Scan off a string.  Warning if terminated by newline or EOF.
X * outfun() outputs the character -- to a buffer if in a macro.
X * TRUE if ok, FALSE if error.
X */
X{
X    register int        c;
X
X    instring = TRUE;        /* Don't strip comments        */
X    (*outfun)(delim);
X    while ((c = get()) != delim
X         && c != '\n'
X         && c != EOF_CHAR) {
X        (*outfun)(c);
X        if (c == '\\')
X        (*outfun)(get());
X    }
X    instring = FALSE;
X    if (c == delim) {
X        (*outfun)(c);
X        return (TRUE);
X    }
X    else {
X        cerror("Unterminated string", NULLST);
X        unget();
X        return (FALSE);
X    }
X}
X
Xscannumber(c, outfun)
Xregister int    c;                /* First char of number    */
Xregister int    (*outfun)();            /* Output/store func    */
X/*
X * Process a number.  We know that c is from 0 to 9 or dot.
X * Algorithm from Dave Conroy's Decus C.
X */
X{
X    register int    radix;            /* 8, 10, or 16        */
X    int        expseen;        /* 'e' seen in floater    */
X    int        signseen;        /* '+' or '-' seen    */
X    int        octal89;        /* For bad octal test    */
X    int        dotflag;        /* TRUE if '.' was seen    */
X
X    expseen = FALSE;            /* No exponent seen yet    */
X    signseen = TRUE;            /* No +/- allowed yet    */
X    octal89 = FALSE;            /* No bad octal yet    */
X    radix = 10;                /* Assume decimal    */
X    if ((dotflag = (c == '.')) != FALSE) {    /* . something?        */
X        (*outfun)('.');            /* Always out the dot    */
X        if (type[(c = get())] != DIG) {    /* If not a float numb,    */
X        unget();            /* Rescan strange char    */
X        return;                /* All done for now    */
X        }
X    }                    /* End of float test    */
X    else if (c == '0') {            /* Octal or hex?    */
X        (*outfun)(c);            /* Stuff initial zero    */
X        radix = 8;                /* Assume it's octal    */
X        c = get();                /* Look for an 'x'    */
X        if (c == 'x' || c == 'X') {        /* Did we get one?    */
X        radix = 16;            /* Remember new radix    */
X        (*outfun)(c);            /* Stuff the 'x'    */
X        c = get();            /* Get next character    */
X        }
X    }
X    for (;;) {                /* Process curr. char.    */
X        /*
X         * Note that this algorithm accepts "012e4" and "03.4"
X         * as legitimate floating-point numbers.
X         */
X        if (radix != 16 && (c == 'e' || c == 'E')) {
X        if (expseen)            /* Already saw 'E'?    */
X            break;            /* Exit loop, bad nbr.    */
X        expseen = TRUE;            /* Set exponent seen    */
X        signseen = FALSE;        /* We can read '+' now    */
X        radix = 10;            /* Decimal exponent    */
X        }
X        else if (radix != 16 && c == '.') {
X        if (dotflag)            /* Saw dot already?    */
X            break;            /* Exit loop, two dots    */
X        dotflag = TRUE;            /* Remember the dot    */
X        radix = 10;            /* Decimal fraction    */
X        }
X        else if (c == '+' || c == '-') {    /* 1.0e+10        */
X        if (signseen)            /* Sign in wrong place?    */
X            break;            /* Exit loop, not nbr.    */
X        /* signseen = TRUE; */        /* Remember we saw it    */
X        }
X        else {                /* Check the digit    */
X        switch (c) {
X        case '8': case '9':        /* Sometimes wrong    */
X            octal89 = TRUE;        /* Do check later    */
X        case '0': case '1': case '2': case '3':
X        case '4': case '5': case '6': case '7':
X            break;            /* Always ok        */
X
X        case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
X        case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
X            if (radix == 16)        /* Alpha's are ok only     */
X            break;            /* if reading hex.    */
X        default:            /* At number end    */
X            goto done;            /* Break from for loop    */
X        }                /* End of switch    */
X        }                    /* End general case    */
X        (*outfun)(c);            /* Accept the character    */
X        signseen = TRUE;            /* Don't read sign now    */
X        c = get();                /* Read another char    */
X    }                    /* End of scan loop    */
X    /*
X     * When we break out of the scan loop, c contains the first
X     * character (maybe) not in the number.  If the number is an
X     * integer, allow a trailing 'L' for long and/or a trailing 'U'
X     * for unsigned.  If not those, push the trailing character back
X     * on the input stream.  Floating point numbers accept a trailing
X     * 'L' for "long double".
X     */
Xdone:    if (dotflag || expseen) {        /* Floating point?    */
X        if (c == 'l' || c == 'L') {
X        (*outfun)(c);
X        c = get();            /* Ungotten later    */
X        }
X    }
X    else {                    /* Else it's an integer    */
X        /*
X         * We know that dotflag and expseen are both zero, now:
X         * dotflag signals "saw 'L'", and
X         * expseen signals "saw 'U'".
X         */
X        for (;;) {
X        switch (c) {
X        case 'l':
X        case 'L':
X            if (dotflag)
X            goto nomore;
X            dotflag = TRUE;
X            break;
X
X        case 'u':
X        case 'U':
X            if (expseen)
X            goto nomore;
X            expseen = TRUE;
X            break;
X
X        default:
X            goto nomore;
X        }
X        (*outfun)(c);            /* Got 'L' or 'U'.    */
X        c = get();            /* Look at next, too.    */
X        }
X    }
Xnomore:    unget();                /* Not part of a number    */
X    if (octal89 && radix == 8)
X        cwarn("Illegal digit in octal number", NULLST);
X}
X
Xsave(c)
Xregister int    c;
X{
X    if (workp >= &work[NWORK])
X        cfatal("Work buffer overflow", NULLST);
X    else *workp++ = c;
X}
X
Xchar *
Xsavestring(text)
Xchar        *text;
X/*
X * Store a string into free memory.
X */
X{
X    register char    *result;
X
X    result = getmem(strlen(text) + 1);
X    strcpy(result, text);
X    return (result);
X}
X
XFILEINFO    *
Xgetfile(bufsize, name)
Xint        bufsize;        /* Line or define buffer size    */
Xchar        *name;            /* File or macro name string    */
X/*
X * Common FILEINFO buffer initialization for a new file or macro.
X */
X{
X    register FILEINFO    *file;
X    register int        size;
X
X    size = strlen(name);            /* File/macro name    */
X    file = (FILEINFO *) getmem(sizeof (FILEINFO) + bufsize + size);
X    file->parent = infile;            /* Chain files together    */
X    file->fp = NULL;            /* No file yet        */
X    file->filename = savestring(name);    /* Save file/macro name    */
X    file->progname = NULL;            /* No #line seen yet    */
X    file->unrecur = 0;            /* No macro fixup    */
X    file->bptr = file->buffer;        /* Initialize line ptr    */
X    file->buffer[0] = EOS;            /* Force first read    */
X    file->line = 0;                /* (Not used just yet)    */
X    if (infile != NULL)            /* If #include file    */
X        infile->line = line;        /* Save current line    */
X    infile = file;                /* New current file    */
X    line = 1;                /* Note first line    */
X    return (file);                /* All done.        */
X}
X
Xchar *
Xgetmem(size)
Xint        size;
X/*
X * Get a block of free memory.
X */
X{
X    register char    *result;
X    extern char    *malloc();
X
X    if ((result = malloc((unsigned) size)) == NULL)
X        cfatal("Out of memory", NULLST);
X    return (result);
X}
X
X/*
X *            C P P   S y m b o l   T a b l e s
X */
X
X/*
X * SBSIZE defines the number of hash-table slots for the symbol table.
X * It must be a power of 2.
X */
X#ifndef    SBSIZE
X#define    SBSIZE    64
X#endif
X#define    SBMASK    (SBSIZE - 1)
X#if (SBSIZE ^ SBMASK) != ((SBSIZE * 2) - 1)
X    << error, SBSIZE must be a power of 2 >>
X#endif
X
Xstatic DEFBUF    *symtab[SBSIZE];    /* Symbol table queue headers    */
X
XDEFBUF *
Xlookid(c)
Xint    c;                /* First character of token    */
X/*
X * Look for the next token in the symbol table.  Returns token in "token".
X * If found, returns the table pointer;  Else returns NULL.
X */
X{
X    register int        nhash;
X    register DEFBUF        *dp;
X    register char        *np;
X    int            temp;
X    int            isrecurse;    /* For #define foo foo    */
X
X    np = token;
X    nhash = 0;
X    if ((isrecurse = (c == DEF_MAGIC)))    /* If recursive macro    */
X        c = get();                /* hack, skip DEF_MAGIC    */
X    do {
X        if (np < &token[IDMAX]) {        /* token dim is IDMAX+1    */
X        *np++ = c;            /* Store token byte    */
X        nhash += c;            /* Update hash value    */
X        }
X        c = get();                /* And get another byte    */
X    } while (type[c] == LET || type[c] == DIG);
X    unget();                /* Rescan terminator    */
X    *np = EOS;                /* Terminate token    */
X    if (isrecurse)                /* Recursive definition    */
X        return (NULL);            /* undefined just now    */
X    nhash += (np - token);            /* Fix hash value    */
X    dp = symtab[nhash & SBMASK];        /* Starting bucket    */
X    while (dp != (DEFBUF *) NULL) {        /* Search symbol table    */
X        if (dp->hash == nhash        /* Fast precheck    */
X         && (temp = strcmp(dp->name, token)) >= 0)
X        break;
X        dp = dp->link;            /* Nope, try next one    */
X    }
X    return ((temp == 0) ? dp : NULL);
X}
X
XDEFBUF *
Xdefendel(name, delete)
Xchar        *name;
Xint        delete;            /* TRUE to delete a symbol    */
X/*
X * Enter this name in the lookup table (delete = FALSE)
X * or delete this name (delete = TRUE).
X * Returns a pointer to the define block (delete = FALSE)
X * Returns NULL if the symbol wasn't defined (delete = TRUE).
X */
X{
X    register DEFBUF        *dp;
X    register DEFBUF        **prevp;
X    register char        *np;
X    int            nhash;
X    int            temp;
X    int            size;
X
X    for (nhash = 0, np = name; *np != EOS;)
X        nhash += *np++;
X    size = (np - name);
X    nhash += size;
X    prevp = &symtab[nhash & SBMASK];
X    while ((dp = *prevp) != (DEFBUF *) NULL) {
X        if (dp->hash == nhash
X         && (temp = strcmp(dp->name, name)) >= 0) {
X        if (temp > 0)
X            dp = NULL;            /* Not found        */
X        else {
X            *prevp = dp->link;        /* Found, unlink and    */
X            if (dp->repl != NULL)    /* Free the replacement    */
X            free(dp->repl);        /* if any, and then    */
X            free((char *) dp);        /* Free the symbol    */
X        }
X        break;
X        }
X        prevp = &dp->link;
X    }
X    if (!delete) {
X        dp = (DEFBUF *) getmem(sizeof (DEFBUF) + size);
X        dp->link = *prevp;
X        *prevp = dp;
X        dp->hash = nhash;
X        dp->repl = NULL;
X        dp->nargs = 0;
X        strcpy(dp->name, name);
X    }
X    return (dp);
X}
X
X#if DEBUG
X
Xdumpdef(why)
Xchar        *why;
X{
X    register DEFBUF        *dp;
X    register DEFBUF        **syp;
X
X    printf("CPP symbol table dump %s\n", why);
X    for (syp = symtab; syp < &symtab[SBSIZE]; syp++) {
X        if ((dp = *syp) != (DEFBUF *) NULL) {
X        printf("symtab[%d]\n", (syp - symtab));
X        do {
X            dumpadef((char *) NULL, dp);
X        } while ((dp = dp->link) != (DEFBUF *) NULL);
X        }
X    }
X}
X
Xdumpadef(why, dp)
Xchar        *why;            /* Notation            */
Xregister DEFBUF    *dp;
X{
X    register char        *cp;
X    register int        c;
X
X    printf(" \"%s\" [%d]", dp->name, dp->nargs);
X    if (why != NULL)
X        printf(" (%s)", why);
X    if (dp->repl != NULL) {
X        printf(" => ");
X        for (cp = dp->repl; (c = *cp++ & 0xFF) != EOS;) {
X        if (c >= MAC_PARM && c <= (MAC_PARM + PAR_MAC))
X            printf("<%d>", c - MAC_PARM);
X        else if (isprint(c) || c == '\n' || c == '\t')
X            putchar(c);
X        else if (c < ' ')
X            printf("<^%c>", c + '@');
X        else
X            printf("<\\0%o>", c);
X        }
X    }
X    else {
X        printf(", no replacement.");
X    }
X    putchar('\n');
X}
X#endif
X
X/*
X *            G E T
X */
X
Xint
Xget()
X/*
X * Return the next character from a macro or the current file.
X * Handle end of file from #include files.
X */
X{
X    register int        c;
X    register FILEINFO    *file;
X    register int        popped;        /* Recursion fixup    */
X
X    popped = 0;
Xget_from_file:
X    if ((file = infile) == NULL)
X        return (EOF_CHAR);
Xnewline:
X#if 0
X    printf("get(%s), recursion %d, line %d, bptr = %d, buffer \"%s\"\n",
X        file->filename, recursion, line,
X        file->bptr - file->buffer, file->buffer);
X#endif
X    /*
X     * Read a character from the current input line or macro.
X     * At EOS, either finish the current macro (freeing temp.
X     * storage) or read another line from the current input file.
X     * At EOF, exit the current file (#include) or, at EOF from
X     * the cpp input file, return EOF_CHAR to finish processing.
X     */
X    if ((c = *file->bptr++ & 0xFF) == EOS) {
X        /*
X         * Nothing in current line or macro.  Get next line (if
X         * input from a file), or do end of file/macro processing.
X         * In the latter case, jump back to restart from the top.
X         */
X        if (file->fp == NULL) {        /* NULL if macro    */
X        popped++;
X        recursion -= file->unrecur;
X        if (recursion < 0)
X            recursion = 0;
X        infile = file->parent;        /* Unwind file chain    */
X        }
X        else {                /* Else get from a file    */
X        if ((file->bptr = fgets(file->buffer, NBUFF, file->fp))
X            != NULL) {
X#if DEBUG
X            if (debug > 1) {        /* Dump it to stdout    */
X            printf("\n#line %d (%s), %s",
X                line, file->filename, file->buffer);
X            }
X#endif
X            goto newline;        /* process the line    */
X        }
X        else {
X            fclose(file->fp);        /* Close finished file    */
X            if ((infile = file->parent) != NULL) {
X            /*
X             * There is an "ungotten" newline in the current
X             * infile buffer (set there by doinclude() in
X             * cpp1.c).  Thus, we know that the mainline code
X             * is skipping over blank lines and will do a
X             * #line at its convenience.
X             */
X            wrongline = TRUE;    /* Need a #line now    */
X            }
X        }
X        }
X        /*
X         * Free up space used by the (finished) file or macro and
X         * restart input from the parent file/macro, if any.
X         */
X        free(file->filename);        /* Free name and    */
X        if (file->progname != NULL)        /* if a #line was seen,    */
X        free(file->progname);        /* free it, too.    */
X        free((char *) file);        /* Free file space    */
X        if (infile == NULL)            /* If at end of file    */
X        return (EOF_CHAR);        /* Return end of file    */
X        line = infile->line;         /* Reset line number    */
X        goto get_from_file;            /* Get from the top.    */
X    }
X    /*
X     * Common processing for the new character.
X     */
X    if (c == DEF_MAGIC && file->fp != NULL)    /* Don't allow delete    */
X        goto newline;            /* from a file        */
X    if (file->parent != NULL) {        /* Macro or #include    */
X        if (popped != 0)
X        file->parent->unrecur += popped;
X        else {
X        recursion -= file->parent->unrecur;
X        if (recursion < 0)
X            recursion = 0;
X        file->parent->unrecur = 0;
X        }
X    }
X    if (c == '\n')                /* Maintain current    */
X        ++line;                /* line counter        */
X    if (instring)                /* Strings just return    */
X        return (c);                /* the character.    */
X    else if (c == '/') {            /* Comment?        */
X        instring = TRUE;            /* So get() won't loop    */
X        if ((c = get()) != '*') {        /* Next byte '*'?    */
X        instring = FALSE;        /* Nope, no comment    */
X        unget();            /* Push the char. back    */
X        return ('/');            /* Return the slash    */
X        }
X        if (keepcomments) {            /* If writing comments    */
X        putchar('/');            /* Write out the    */
X        putchar('*');            /*   initializer    */
X        }
X        for (;;) {                /* Eat a comment    */
X        c = get();
Xtest:        if (keepcomments && c != EOF_CHAR)
X            cput(c);
X        switch (c) {
X        case EOF_CHAR:
X            cerror("EOF in comment", NULLST);
X            return (EOF_CHAR);
X
X        case '/':
X            if ((c = get()) != '*')    /* Don't let comments    */
X            goto test;        /* Nest.        */
X#ifdef VERBOSE
X            cwarn("Nested comments", NULLST);
X#endif
X                        /* Fall into * stuff    */
X        case '*':
X            if ((c = get()) != '/')    /* If comment doesn't    */
X            goto test;        /* end, look at next    */
X            instring = FALSE;        /* End of comment,    */
X            if (keepcomments) {        /* Put out the comment    */
X            cput(c);        /* terminator, too    */
X            }
X            /*
X             * A comment is syntactically "whitespace" --
X             * however, there are certain strange sequences
X             * such as
X             *        #define foo(x)    (something)
X             *            foo|* comment *|(123)
X             *       these are '/' ^           ^
X             * where just returning space (or COM_SEP) will cause
X             * problems.  This can be "fixed" by overwriting the
X             * '/' in the input line buffer with ' ' (or COM_SEP)
X             * but that may mess up an error message.
X             * So, we peek ahead -- if the next character is
X             * "whitespace" we just get another character, if not,
X             * we modify the buffer.  All in the name of purity.
X             */
X            if (*file->bptr == '\n'
X             || type[*file->bptr & 0xFF] == SPA)
X            goto newline;
X#if COMMENT_INVISIBLE
X            /*
X             * Return magic (old-fashioned) syntactic space.
X             */
X            return ((file->bptr[-1] = COM_SEP));
X#else
X            return ((file->bptr[-1] = ' '));
X#endif
X
X        case '\n':            /* we'll need a #line    */
X            if (!keepcomments)
X            wrongline = TRUE;    /* later...        */
X        default:            /* Anything else is    */
X            break;            /* Just a character    */
X        }                /* End switch        */
X        }                    /* End comment loop    */
X    }                    /* End if in comment    */
X    else if (!inmacro && c == '\\') {    /* If backslash, peek     */
X        if ((c = get()) == '\n') {        /* for a <nl>.  If so,    */
X        wrongline = TRUE;
X        goto newline;
X        }
X        else {                /* Backslash anything    */
X        unget();            /* Get it later        */
X        return ('\\');            /* Return the backslash    */
X        }
X    }
X    else if (c == '\f' || c == VT)        /* Form Feed, Vertical    */
X        c = ' ';                /* Tab are whitespace    */
X    return (c);                /* Just return the char    */
X}
X
Xunget()
X/*
X * Backup the pointer to reread the last character.  Fatal error
X * (code bug) if we backup too far.  unget() may be called,
X * without problems, at end of file.  Only one character may
X * be ungotten.  If you need to unget more, call ungetstring().
X */
X{
X    register FILEINFO    *file;
X
X    if ((file = infile) == NULL)
X        return;            /* Unget after EOF        */
X    if (--file->bptr < file->buffer)
X        cfatal("Too much pushback", NULLST);
X    if (*file->bptr == '\n')    /* Ungetting a newline?        */
X        --line;            /* Unget the line number, too    */
X}
X
Xungetstring(text)
Xchar        *text;
X/*
X * Push a string back on the input stream.  This is done by treating
X * the text as if it were a macro.
X */
X{
X    register FILEINFO    *file;
X    extern FILEINFO        *getfile();
X
X    file = getfile(strlen(text) + 1, "");
X    strcpy(file->buffer, text);
X}
X
Xint
Xcget()
X/*
X * Get one character, absorb "funny space" after comments or
X * token concatenation
X */
X{
X    register int    c;
X
X    do {
X        c = get();
X#if COMMENT_INVISIBLE
X    } while (c == TOK_SEP || c == COM_SEP);
X#else
X    } while (c == TOK_SEP);
X#endif
X    return (c);
X}
X
X/*
X * Error messages and other hacks.  The first byte of severity
X * is 'S' for string arguments and 'I' for int arguments.  This
X * is needed for portability with machines that have int's that
X * are shorter than  char *'s.
X */
X
Xstatic
Xdomsg(severity, format, arg)
Xchar        *severity;        /* "Error", "Warning", "Fatal"    */
Xchar        *format;        /* Format for the error message    */
Xchar        *arg;            /* Something for the message    */
X/*
X * Print filenames, macro names, and line numbers for error messages.
X */
X{
X    register char        *tp;
X    register FILEINFO    *file;
X
X    fprintf(stderr, "%sline %d, %s: ", MSG_PREFIX, line, &severity[1]);
X    if (*severity == 'S')
X        fprintf(stderr, format, arg);
X    else
X        fprintf(stderr, format, (int) arg);
X    putc('\n', stderr);
X    if ((file = infile) == NULL)
X        return;                /* At end of file    */
X    if (file->fp != NULL) {
X        tp = file->buffer;            /* Print current file    */
X        fprintf(stderr, "%s", tp);        /* name, making sure    */
X        if (tp[strlen(tp) - 1] != '\n')    /* there's a newline    */
X        putc('\n', stderr);
X    }
X    while ((file = file->parent) != NULL) {    /* Print #includes, too    */
X        if (file->fp == NULL)
X        fprintf(stderr, "from macro %s\n", file->filename);
X        else {
X        tp = file->buffer;
X        fprintf(stderr, "from file %s, line %d:\n%s",
X            (file->progname != NULL)
X            ? file->progname : file->filename,
X            file->line, tp);
X        if (tp[strlen(tp) - 1] != '\n')
X            putc('\n', stderr);
X        }
X    }
X}
X
Xcerror(format, sarg)
Xchar        *format;
Xchar        *sarg;        /* Single string argument        */
X/*
X * Print a normal error message, string argument.
X */
X{
X    domsg("SError", format, sarg);
X    errors++;
X}
X
Xcierror(format, narg)
Xchar        *format;
Xint        narg;        /* Single numeric argument        */
X/*
X * Print a normal error message, numeric argument.
X */
X{
X    domsg("IError", format, (char *) narg);
X    errors++;
X}
X
Xcfatal(format, sarg)
Xchar        *format;
Xchar        *sarg;            /* Single string argument    */
X/*
X * A real disaster
X */
X{
X    domsg("SFatal error", format, sarg);
X    exit(IO_ERROR);
X}
X
Xcwarn(format, sarg)
Xchar        *format;
Xchar        *sarg;            /* Single string argument    */
X/*
X * A non-fatal error, string argument.
X */
X{
X    domsg("SWarning", format, sarg);
X}
X
Xciwarn(format, narg)
Xchar        *format;
Xint        narg;            /* Single numeric argument    */
X/*
X * A non-fatal error, numeric argument.
X */
X{
X    domsg("IWarning", format, (char *) narg);
X}
X
X
X
END-of-cpp6.c
exit